Aminet 1

home *** CD-ROM | disk | FTP | other *** search

/ Aminet 1 / Aminet - June 1993 [Walnut Creek].iso / usenet / sources / volume90 / aplictns / dtc / part01 next >

Wrap

Internet Message Format | 1990-03-14 | 42.4 KB

Path: xanth!cs.odu.edu!Amiga-Request From: Amiga-Request@cs.odu.edu (Amiga Sources/Binaries Moderator) Newsgroups: comp.sources.amiga Subject: v90i107: DTC - desktop calendar, Part01/06 Message-ID: <11786@xanth.cs.odu.edu> Date: 14 Mar 90 01:29:42 GMT Sender: tadguy@cs.odu.edu Reply-To: "Glenn Everhart: 215 354 7610 (8*747 7610)" <EVERHART@ARISIA.dnet.ge.com> Lines: 1503 Approved: tadguy@cs.odu.edu (Tad Guy) X-Mail-Submissions-To: Amiga@cs.odu.edu X-Post-Discussions-To: comp.sys.amiga Submitted-by: "Glenn Everhart: 215 354 7610 (8*747 7610)" <EVERHART@ARISIA.dnet.ge.com> Posting-number: Volume 90, Issue 107 Archive-name: applications/dtc/part01 [ the two main source modules, Dtc.For and Dtc2.For have been split to to allow for posting. remember to join them before compiling. ...tad ] DTC is a utility providing a simple calendar on your desk which can hold and show appointments and be useful in managing your time. Its chief goals were to provide Day, Week, and Month at a glance for any date between 1/1/0001 and 12/31/9999, defaulting to the current system date. It is menu driven and fairly easy to use. #!/bin/sh # This is a shell archive. Remove anything before this line, then unpack # it by saving it into a file and typing "sh file". To overwrite existing # files, type "sh file -c". You can also feed this as standard input via # unshar, or by typing "sh <file", e.g.. If this archive is complete, you # will see the following message at the end: # "End of archive 1 (of 6)." # Contents: DTC.DAT DTC.Man DefCentry.Inc Dtc2.For.ac appdtc.inc # apptdtc.inc comdtc.inc comdtcd.inc dtc.hlp dtcmak.cmd dtcrelnt.txt # dtcxidate.inc escdtc.inc escdtcd.inc stmtfunc.for stmtfuncsp.for # Wrapped by tadguy@xanth on Tue Mar 13 20:29:20 1990 PATH=/bin:/usr/bin:/usr/ucb ; export PATH if test -f 'DTC.DAT' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'DTC.DAT'\" else echo shar: Extracting \"'DTC.DAT'\" $371 characters$ sed "s/^X//" >'DTC.DAT' <<'END_OF_FILE' X19860911160 test a X19860912160 test b 4pm X19860911123 lunchtime appt X19860911170 X X19881231120 Lunchtime X19881231163 Gail, Craig, + Linda arrive END_OF_FILE if test 371 -ne `wc -c <'DTC.DAT'`; then echo shar: \"'DTC.DAT'\" unpacked with wrong size! fi # end of 'DTC.DAT' fi if test -f 'DTC.Man' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'DTC.Man'\" else echo shar: Extracting \"'DTC.Man'\" $4531 characters$ sed "s/^X//" >'DTC.Man' <<'END_OF_FILE' XDesk Top Calendar (DTC) X XDTC is a utility providing a simple calendar on your desk which can Xhold and show appointments and be useful in managing your time. X Its chief goals were to provide Day, Week, and Month at a Xglance for any date between 1/1/0001 and 12/31/9999, defaulting to Xthe current system date. It is menu driven and fairly easy to use. X X Installation: X 1. Move the DTC.HLP file to directory C: so the online H Xcommand can find it. X 2. Move the DTC file where it can be run. (You may have to Xenlarge the stack with a STACK command for DTC to work; it is Xwritten in Fortran and the Absoft compiler seems to have that Xproperty. If in doubt try STACK 50000.) (I believe that the default Xstack will work OK normally). X X 3. Type DTC to fire it up. The Q command returns to AmigaDOS. X X Use: X X DTC fires up a CON: window which will generally fill the whole Xscreen or the top halfscreen if in high res mode. Commands are entered Xfrom the keyboard; a menu is initially displayed. X DTC2 uses the current window and just uses whatever of it is Xneeded; it needs more or less an 80 by 24 area. Other than this DTC Xand DTC2 work much alike. However, DTC2 probably will not be interfered Xwith by ConMan 1.3. X X Commands include: X X I Initialize date to current system date. Sometimes needed X to avoid major brain damage in date used. X D Date Time Appt - Enters Appt (up to 60 chars) in date and time X given. Just about any normally used date and time format X will be accepted. Years can be 2 or 4 digits; in the former X case the 20th century is assumed. Just giving the D command X (or just D date) displays the Day's appointments. Note that X E is a pseudo time meaning Evening (5PM or later). You can X use 12 or 24 hour time; DTC understands both. It assumes X appointments are in the prime shift, however. X W date - Displays times for appointments for the week containing X date. X M date - Displays days with appointments for the month specified. XNote: a Year command exists but messes up unless display can handle 132 Xcolumns; the Amiga can't so don't use it... X S date time appt - Schedule appt in all files indirectly pointed X at. Appointments are normally stored in file DTC.DAT preceded X by YYYYMMDDHHH. If the YYYYMMMDDHHH is 999999999999, DTC X will assume the rest of the line is a filename (ending in = X generally) and will look there also during appointment X scans. Where the L or NW commands are used to set up a X meeting, a file might be used with pointers like this to X a large group of people. The S command is provided to X let you put meeting notices in the INDIRECTED files X instead of just in the TOP LEVEL file like the D command. X F filename - Changes the DTC appointment file to filename. Any X filename the system can understand is OK with DTC. X L date nn - Locates periods of nn half-hours that are free in X the week containing date. These are times when a meeting X of length nn/2 hours could start that week. X NW, ND - Show free times during week or day. Reverses display sense X for busy/free. Handy if you have a BUSY schedule. X P date - Purge appointments, destroying any older than date. X X date1 time1 date2 time2 - eXchange appointment from date1, time1 X to date2 time2. X U date time - Unschedule appointment at date, time. X Q - Quit DTC. Exit the program. X Times of form HH:MM>hh:mm (e.g. 12:00>15:00) express time X ranges and fill in blocks of time if so desired. X The program attempts to display the current time/date X in reverse video or similar renditions where possible and X to show default dates by underlining. X +nD X +nW X +nM X +nY Move default display forward by n Days, Weeks, Months, or X Years. N defaults to 1 and the unit defaults to the last X displayed one. X -nD X -nW X -nM X -nY Ditto, back n days, weeks, months, or years. X X H - displays DTC.HLP on screen. Not a very powerful help system X but simple to use. X X This version of DTC comes from work done by Mitch Wyle, Glenn X Everhart, and Charles Garman for PDP11 and VAX versions. The X VAX VMS version was ported to Amiga by Glenn Everhart (mainly X in preparation for porting a spreadsheet, to learn the compiler's X idiosyncracies). Complete sources are presented. While it is not X as polished as it could be, it seems to be fully functional (at X least on my Amiga in 512K under 1.2 beta 6) and serves a purpose X nothing else I have seen serves. Enjoy. If anyone improves this X version, please forward me a copy. X X DTC also works OK under AmigaDos 1.3. X Glenn Everhart X 25 Sleigh Ride Rd. X Glen Mills, Pa 19342 END_OF_FILE if test 4531 -ne `wc -c <'DTC.Man'`; then echo shar: \"'DTC.Man'\" unpacked with wrong size! fi # end of 'DTC.Man' fi if test -f 'DefCentry.Inc' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'DefCentry.Inc'\" else echo shar: Extracting \"'DefCentry.Inc'\" $131 characters$ sed "s/^X//" >'DefCentry.Inc' <<'END_OF_FILE' X integer*4 icentry X parameter (icntry = 1900) XC Default century XC -h- dtcxidate.inc Tue Jul 8 16:16:24 1986 END_OF_FILE if test 131 -ne `wc -c <'DefCentry.Inc'`; then echo shar: \"'DefCentry.Inc'\" unpacked with wrong size! fi # end of 'DefCentry.Inc' fi if test -f 'Dtc2.For.ac' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'Dtc2.For.ac'\" else echo shar: Extracting \"'Dtc2.For.ac'\" $21276 characters$ sed "s/^X//" >'Dtc2.For.ac' <<'END_OF_FILE' X end if XC (unlike Schlitz, we can go around twice) X X if (idisp .ne. idspp) then XC other than purge Xc *** itx2 = 175 XC Set default for '*' or <null> X call dtctimcvt(itx1, itx2) X if (itx1 .eq. itx2) X 1 itx2 = itx2 + 1 XC Add (10 mins) to allow semi-open interval X if (first) then X it1 = itx1 X it2 = itx2 X if (idisp .eq. idspx) then X if (ln1 .eq. 0) go to 999 XC Error if nothing left X first = .false. X go to 10 XC Re-cycle code X end if XC Done unless X X end if X else XC P, guarantee no redisplay X ln1 = 0 XC Zap the line X end if XC Done parse for U, X X end if XC Done date/time parse X X ixhash = ihymd(iye, im, id) XC Calc hash for day of interest X Xc *** type 950, ixhash Xc *** 950 format(2z9.8) X X if (idisp .eq. idspp) X 1 then XC Set request date for RDAPPT X irqhash(1) = ixhash XC Delete before X else X irqhash(1) = 0 XC Look at everybody X end if X X irqhash(2) = Z'7FFFFFFF' XC 'Til the end of time X X firstflg = 0 XC Zero until file opened for write X X prveof = 0 X eofflg = -1 X X do while (prveof .ge. 0) X X call dtcrdappt(eofflg, 1) XC Look at control entries X X if (eofflg .gt. 0) X 1 then X eofflg = 0 XC Don't open it on return X go to 190 XC but re-write it as is X XC Test it now X else if (eofflg .eq. 0) X 1 then X Xc *** type 950, irchash X X iht = min0(max0(iht, 80), 173) XC Insure a kosher time value X X go to (110, 120, 130) idisp XC Dispatch on numeric value X go to 190 XC Bad call, re-write anyway? X X 120 if ((irchash .eq. ixhash) .and. X 1 ((iht .ge. it1) .and. (iht .lt. it2))) X 2 go to 100 XC Criteria for Unscheduling (deleting) X go to 190 XC Do re-write X X 130 if ((irchash .eq. ixhash) .and. X 1 ((iht .ge. it1) .and. (iht .lt. it2))) X 2 then X X iht = itx1 + (iht - it1) XC Get updated time X if (mod(iht, 10) .eq. 6) iht = iht + 4 XC go to next hour X X if (iht .gt. itx2) go to 100 XC Duration was shortened X X ihy = ibigyr XC Change dates X ihm = idmo X ihd = iddy X X end if XC Usually re-write Xc X 110 continue XC Purge, re-write X XC Can't open output till X 190 if (firstflg .eq. 0) X 1 then XC we have input XC X X close(3) Xc open(unit=3, file=FNc(1:fnsz), status='NEW', Xc 1 form='FORMATTED', Xc 1 err=999) X9991 continue X open(unit=3, file='DTC.TMP', status='NEW', X 1 form='FORMATTED', X 1 err=999) X iopn2=1 Xc flag we got DTC.TMP open... X firstflg = 1 XC Output now open X X end if X X write (3, 201,err=9991) ihy, ihm, ihd, iht, X 1 apptstr(1:min0(max0(iaptln, 1), iaptlim)) Xc *** 1 (appoin(k), k=1, min0(max0(iaptln, 1), iaptlim)) X 201 format(i4.4, 2i2.2, i3.3, x, a) XC New format, 19850806113 X X end if XC eofflg X X 100 prveof = eofflg XC Set loop condition X X end do XC while X XC Purged everything? X if (firstflg .eq. 0) X 1 then XC create empty file X X close(3) Xc open(unit=3, file=FNc(1:fnsz), status='NEW', Xc 1 form='FORMATTED', Xc 1 err=999) X open(unit=3, file='DTC.TMP', status='NEW', X 1 form='FORMATTED', X 1 err=999) X iopn2=1 X firstflg = 1 XC Output now open X X end if X X if(iopn2.le.0)goto 9403 Xc Amiga ... Xc rewind 1 and 2, then copy DTC.TMP into DTC.DAT (or wherever) Xc Rewind 1 X close(1) X close(4) X open(unit=4, file=FNc(1:fnsz), status='NEW', X 1 form='FORMATTED',err=999) Xc re-open unit 4 if we can, for write... Xc Rewind 3 X close(3) X open(unit=3, file='DTC.TMP', status='old', X 1 form='FORMATTED', X 1 err=999) X X9402 continue X Read (3,201,end=9401,err=9401) ihy,ihm,ihd,iht,apptstr Xc read temp file, write back new appt file X write (4, 201,err=9401) ihy, ihm, ihd, iht, apptstr Xc 201 format(i4.4, 2i2.2, i3.3, x, a) X goto 9402 X9401 continue X close(3,Status='delete') X close(4) X firstflg=0 X iopn2=0 X9403 continue X close(3) X close(2) X close(4) X close(1) XC Done with new files X X return X X 999 write (*, 990) XC Error on decode, write nastygram X 990 format($,'Syntax or file-open (write) error.', $) X ln1 = 0 XC Inhibit rescan Xc X end XC -h- dtcdatcvt.for Tue Jul 8 16:07:21 1986 Xc Date conversion function (part of DTC), derived from DATMUN, Xc except decodes the values directly into DEFDAT and shrinks LINE, Xc rather than schlep LINE back and forth to kingdom come. XC Modified 850422, CG, to restrict values of month/day/year XC modified 850325, 850726 & 850731, CG, to allow any of the following: Xc d{d}/m{m}/{y}y, d, dd, dmm, ddmm, dmmyy, ddmmyy, dmmyyyy, ddmmyyyy Xc for D or W functions Xc m{m}/{y}y, m, mm, myy, mmyy, mmyyyy, myyyy for M Xc y, yy, yyy, yyyy for Y XC plus dd-mon-yy, dd-mm-yy, dd-xii-yy formats XC function: Xc Convert a line starting with a date of form Xc mmddyy OR mm/dd/yy OR dd-mon-yy OR dd-romn-yy Xc to binary equivalents, and remove from line, copying binary values Xc to DEFDAT in common. XC Leaves whatever follows the date alone. Xc Added for DTC to not have to use such a crock date Xc format as the original; too hard to use otherwise. X X Subroutine dtcdatcvt (nf) XC (line,nf) Xc Xc implicit none Xc X Integer*4 nf XC Number of fields expected Xc X include comdtc.INC Xc X INTEGER*1 nb, l1, l2, l3, l4, lxx(4), work(icmln), tb6(6) XC, Xc XC lengths of months (30 days hath Sept ...) X Integer*4 lm(12) Xc XC Min chars to recognize month names X Integer*4 minln(12) X XC Decode month names, or European style w/ Roman months X character*4 rch,mab(12),rom(12) X X Integer*4 i, k, kkk, n, nn, ix, ixyr, ixmo, ixdy, nfd, X 1 ifnb, lnb, lcount X X logical longyr XC If year entered as 3 chars or more X X integer*2 iwk(42), lw1 X integer*1 iwkk(84),ln1 X Character*1 ln1c X Equivalence (work,iwkk) XC 2 chars at a time Xc X Integer*4 ll1 X X equivalence(line(1),ln1) X equivalence (ln1,lw1),(ll1,rch) X equivalence (rch, lxx), (work, iwk) X equivalence(line(1),ln1c) Xc X Integer*4 icvt10, icur X INTEGER*1 ich X include stmtfuncsp.for X include comdtcd.inc X X Data lm X 1 /31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31/ Xc XC Min chars to recognize month names X Data minln X 1 /2, 1, 3, 2, 3, 3, 3, 2, 1, 1, 1, 1/ X XC Decode month names, or European style w/ Roman months X Data X 1 mab / 'JANU', 'FEBR', 'MARC', 'APRI', 'MAY ', 'JUNE', X 2 'JULY', 'AUGU', 'SEPT', 'OCTO', 'NOVE', 'DECE'/, X 3 rom / 'I ', 'II ', 'III ', 'IV ', 'V ', 'VI ', X 4 'VII ', 'VIII', 'IX ', 'X ', 'XI ', 'XII '/ X X include stmtfunc.for X icvt10(icur, ich) = (icur * 10) + icvtbn1(ich) XC conversion function stage X Xc Begin code X X longyr = .false. XC set default of century calculation X Xc Initialize default values for omitted fields X X ixyr = ibigyr XC Copy current values X ixmo = idmo XC from common X ixdy = iddy X if (numeric(ln1)) then XC Dates must start with number X X work(1) = ln1 XC Copy first character X ix = icvtbn1(ln1) XC Compute value on the fly Xc X do (n = 2, (nf * 2) + 2) XC Allow [mm][dd][yyyy] Xc X l1 = line(n) XC Copy current character X XC Field separators: slash X if (l1 .eq. ichar('/')) X 1 go to 100 XC for mm/dd/yy form X XC .. dash X if (l1 .eq. ichar('-')) X 1 go to 200 XC for dd-mmm-yy form X X if ((l1 .eq. ichar(':')) .or. (l1 .eq.ichar('>'))) X 1 go to 999 XC hour-string first, return default values XC anything else: X if (.not. numeric(l1)) X 1 go to 300 XC mmddyy, minus some characters, fake whatever is required X X work(n) = l1 XC Don't recopy X ix = icvt10(ix, l1) XC continue conversion X X end do X X n = (nf * 2) + 3 XC Set shrink value if no delimiter X X go to 300 XC Go convert it X X else if ((ln1c .eq. '+') .or. (ln1c .eq. '-')) then X k = incmod XC Save current value X call dtcdatinc XC Convert incremental date X incmod = k XC Restore X else if (ln1c .eq. '=') then X kkk = 1 XC Place holder, strip only, date n/c X go to 950 X end if XC (don't want to reformat whole file) X X go to 999 XC All done here X Xc handle mm/dd or mm/dd/yy{yy} (for D, W, M or Y) Xc or mm/yy{yy} (for M or Y) X X 100 continue XC Here for '/' encountered in first scan loop X X k = n + 1 XC next character to look at X l1 = line(k) X if (.not. numeric(l1)) go to 300 XC nnnn/x ??? X X ixmo = ix XC First field is always month in "/" notation X X ix = icvtbn1(l1) XC Start 2nd conversion X X do (n = k + 1, 20) XC should be plenty X X l1 = line(n) XC get character X if (l1 .eq. ichar('/')) go to 110 XC Found second / X if (.not. numeric(l1)) go to 120 XC End of scan X ix = icvt10(ix, l1) XC convert X X end do X X n = 21 XC Set it X X 120 if (nf .eq. 3) then X ixdy = ix XC 2nd field is day X else X ixyr = ix XC .. year X longyr = ((n - k) .gt. 2) X end if X X go to 900 X X 110 l1 = line(n+1) XC Found 2nd slash, check for third field X if (.not. numeric(l1)) go to 120 XC left field XC X X k = n + 1 X X ixdy = ix XC 2nd has to be day X X ixyr = icvtbn1(l1) XC Start 3rd conversion (year) X X do (n = k + 1, 20) XC get more numerics X X l1 = line(n) X if (.not. numeric(l1)) go to 910 X ixyr = icvt10(ixyr, l1) X X end do X X n = 21 XC mark next character X X go to 910 XC set for SHRINK X Xc handle dd-mon-yy, dd-mm-yy, or dd-roman-yy X X 200 continue XC Here for '-' in first scan loop X X ixdy = ix XC Copy converted day field X X rch = ' ' XC initialize for alpha month name, or Roman numerals X X k = n + 1 XC next char after "-" X X l1 = line(k) X X if (numeric(l1)) then XC European format dd-mm-yy X X ixmo = icvtbn1(l1) XC go for it directly X X do (n = k + 1, 20) X X l1 = line(n) X X if (.not. numeric(l1)) go to 210 X X ixmo = icvt10(ixmo, l1) X X end do X X n = 21 X X else if (alpha(l1)) then X X lxx(1) = l1 .and. z'5F5f5f5f' XC Set first char for name or roman X X lcount = 1 X X do (nn = k + 1, k + 6) XC should find "-" by then X X l1 = line(nn) X if (l1 .eq. ichar('-')) go to 230 XC Start search X if (.not. alpha(l1)) go to 230 XC also terminate X if (lcount .lt. 4) then XC room for at least one more X lcount = lcount + 1 X lxx(lcount) = l1 .and. z'5F5f5f5f' XC Copy character X end if X end do X X nn = k + 6 X X 230 continue X X do (i = 1, 12) XC Loop over months X if (rch .eq. rom(i)) go to 250 XC Found match in roman set X if (lcount .ge. minln(i)) then X if (rch(1:lcount) .eq. mab(i)(1:lcount)) X 1 go to 250 XC Found match in alpha names X end if X XC Note: last two IF statements above replace original horrendous sequence of Xc IF-THEN-ELSEs to see if month was J then A, or F, or M then A then R, etc XC X end do X Xc Fell out of loop, leave current month X X go to 300 XC Unknown month or roman seq, back up before "-" X X 250 ixmo = i XC iwk(1) = icvtbcd(i) X n = nn XC Accept characters X X else XC "-" followed by non alphanumeric X go to 300 X end if X X 210 if (l1 .ne. ichar('-')) go to 900 XC See if year follows X X k = n + 1 X l1 = line (k) X X if (.not. numeric(l1)) go to 910 XC First dash is left X ixyr = icvtbn1(l1) X X do (n = k + 1, 30) X X l1 = line (n) X X if (.not. numeric(l1)) go to 910 X X ixyr = icvt10(ixyr, l1) X X end do X X n = 31 X X 910 longyr = ((n - k) .gt. 2) XC Set logic value X X go to 900 X X300 continue XC Short string found, fix it up X X nfd = n/2 XC Number of 2-char groups found X X longyr = (nfd .gt. nf) XC check for default or forced century X X if ((n .and. 1) .eq. 0) then XC Example: n = 5 for 4 chars found (0 mod 2) X work(1) = '0' XC Force even number of characters X do (i = 2, n) X work(i) = line(i - 1) XC Shift line over by 1 X end do X end if X X go to (310, 320, 330) nf XC Dispatch on # expected fields X go to 900 XC Bad value ??? X X 310 ixyr = ix XC take year: Y [yy] X go to 900 XC End case X X 320 ixmo = icvtbin(iwkk(1)) XC M mm X if (nfd .eq. 2) ixyr = icvtbin(iwkk(3)) XC M {m}myy X if (nfd .eq. 3) ixyr = mod(ix, 10000) XC M {m}myyyy X go to 900 XC End case X X 330 if (nfd .eq. 1) ixdy = icvtbin(iwkk(1)) XC D {d}d {only} X X if (nfd .ge. 2) then XC D [mm]dd[yy] X ixmo = icvtbin(iwkk(1)) XC D {m}mdd X ixdy = icvtbin(iwkk(3)) XC D {m}mdd X end if X X if (nfd .eq. 3) ixyr = icvtbin(iwkk(5)) XC D {m}mddyy X if (nfd .eq. 4) ixyr = mod(ix, 10000) XC D {m}mddyyyy X X 900 continue XC common clean-up & return X XC Check for 1-99 AD X if ((ixyr .lt. 100) .and. (.not. longyr)) X 1 ixyr = ixyr + ((ibigyr/100)*100) XC add "current" century X X if (islpyr(ixyr)) X 1 then X lm(2) = 29 XC Set for Leap Years X else X lm(2) = 28 XC reset for "common" years X end if X X ibigyr = ixyr XC Explicit year X idmo = min0(max0(ixmo, 1), 12) XC Limit values X iddy = min0(max0(ixdy, 1), lm(idmo)) XC .. X X kkk = n - 1 XC Change index of next char to count X X 950 idyr = mod(ibigyr, 100) XC Set value X X if (kkk .gt. 0) X 1 call shrink (kkk, ifnb, lnb) XC Unload the stuff we used X X 999 return XC Miscellaneous exits X end Xc -h- dtctimcvt.for Tue Jul 8 16:08:13 1986 Xc Subroutine to extract and convert time-of-day string for DTC package Xc Converts string of form hh:mm to Integer*4 between 80 and 173 Xc (half-hour intervals). If range h1:m1>h2:m2 is present, second Xc value is returned, else same as t1>t1. X Xc Special cases Xc * => {itr1}>{itr2} Xc E or EV => 17:00 Xc h: => 0h:00 Xc h:n => 0h:n0 (if n .ge. 3, then 3, else 0) Xc h1>h2 => h1:00>h2:00 X Xc If ':' or '>' is not 2nd or 3rd character, or not '*', 'E' or 'EV', Xc entire string is left untouched, and default values are returned Xc (parameters unchanged) X X subroutine dtctimcvt (itr1, itr2) X X include comdtc.INC X X INTEGER*1 ll, ln1, wk(2) X integer*2 iwk X character*2 icwk X equivalence(icwk,iwk) X integer*1 iwkk X logical first, expectmin X X equivalence (line(1), ln1), (iwk, wk) X equivalence(iwkk,wk(1)) X include stmtfuncsp.for X include comdtcd.inc X include stmtfunc.for X X it1 = itr1 XC Caller's limits X it2 = itr2 XC (formerly 8:00 AM > 5:30 PM) X X ix = 0 XC Amount to strip X if(ln1.gt.96)ln1=ln1-32 X if (ln1 .eq. ichar('*')) then XC Check special cases first X X ix = 1 XC Defaults, dump 1 char X X else if ((ln1 ) .eq. ichar('E')) then X X it1 = 170 XC Set eventide X it2 = it1 X X ix = 1 X if(line(2).gt.96)line(2)=line(2)-32 X if ((line(2)) .eq. ichar('V')) ix = 2 X X else X X i = 0 XC Temp index X first = .true. XC Helpful X X 10 if (numeric(line(i+1))) then X X if (numeric(line(i+2))) then X wk(1) = line(i+1) X wk(2) = line(i+2) X read(icwk,850)ih X850 format(BZ ,I2) X ih=ih*10 Xc ih = icvtbin(iwkk) * 10 X i = i + 2 X else X ih = icvtbn1(line(i+1)) * 10 X i = i + 1 X end if X X if (line(i+1) .eq. ichar(':')) then X i = i + 1 X if (numeric(line(i+1))) then X im = icvtbn1(line(i+1)) X if (im .ge. 3) then X im = 3 X else X im = 0 X end if X ih = ih + im X i = i + 1 X if (numeric(line(i+1))) i = i + 1 XC Just ignore it X end if X ix = i XC Accept all processed chars X end if X X if ((ih .ge. 10) .and. (ih .lt. 70)) X 1 ih = ih + 120 XC Force early AM to PM X ih = min0(max0(ih, 80), 180) XC Normalize within limits X X if (line(i+1) .eq. ichar('>')) then X i = i + 1 X ix = i XC Insure it gets copied X it2 = ih X if (first) then X it1 = it2 X first = .false. X go to 10 X end if X else if (ix .ne. 0) then XC Got some numeric X if (first) then X it1 = ih XC terminated by ':' X it2 = ih XC first time t1>t1 X else X it2 = ih XC 2nd numeric X ix = i XC Claim everything looked at X end if XC Which time X end if XC Range delimiter ('>') X end if XC First numeric X end if XC All others unrecognized (includes EOL) X X itr1 = it1 XC All exit here X itr2 = max0(it2, it1) XC Make sure range OK X X if (ix .ne. 0) call shrink (ix, ifnb, lnb) XC Unload what we've used X X end XC -h- shrink.for Tue Jul 8 16:08:41 1986 Xc Subroutine to shift LINE to left after current item has been scanned Xc deletes blanks between that point and first non-blank character Xc Performs no operation if current item is EOL (binary 0) X Xc Sets return arguments pointing to first and last non-blank characters X X subroutine shrink (iskip, ifnbr, lnbr) Xc X include comdtc.INC X X INTEGER*1 ll X include comdtcd.inc X X ifnb = 0 X lnb = 0 X X if (line(1) .eq. 0) go to 999 XC Exit immediately X X ix = iskip + 1 XC start looking X do while ((ix .le. icmln) .and. (line(ix) .ne. 0)) X if (line(ix) .gt. 32) go to 10 XC Found something X ix = ix + 1 X end do X line(1) = 0 XC Flag end, no copy X go to 999 X X 10 ifnb = 1 X lnb = 1 X X Do (i = 1, icmln-ix) X X ll = line(ix) X line(i) = ll X if (ll .eq. 0) go to 999 XC Stop at EOL X if (ll .gt. 32) lnb = i X ix = ix + 1 X end do X line(min0(lnb+1, icmln)) = 0 XC Flag EOL if not found X X 999 ifnbr = ifnb XC Set return values X lnbr = lnb X X end XC -h- dtcat.for Tue Jul 8 16:09:05 1986 X subroutine dtcat(ic,ir) XC x, y Xc X include comdtc.INC XC Need ITERM X include escdtc.INC XC X include comdtcd.inc X include escdtcd.inc X write(*,773) X773 format(' ') Xc write once to flush extra junk out... then position. X write(*, 2, err=3) esc,'[',ir,';',ic,'H' X 2 format($,2a1,i2.2,a1,i3.3,a1,$) XC Max rows is 2-digit number Xc X return Xc X 3 write (*,10) esc,homescrn, ir, ic X 10 format($, 2a, 'Error in DTCAT, row/col =', 2z5.4, ' (hex).') X end XC -h- gaby.for Tue Jul 8 16:10:23 1986 Xc----------------------------------------------------------------------- XC Subroutine Gaby XC Part of Mitch Wyle's DTC program XC return a string corresponding to the month number Xc Month number contained in im. Send back string in monthn. Xc (JANUARY for 1, etc.) XC----------------------------------------------------------------------- XC modified 850315 - Center month names in table, use mixed case - CG X X SUBROUTINE gaby(im,monthn) X XC Declarations: Xc X INTEGER*1 monthn(9) XC Table of month names and numbers (centered, even lengths biased left): Xc X X INTEGER*1 months(9,14) X character*9 monthch(14) X X equivalence (months, monthch) XC Select the right month and fill monthn with it: Xc X Data monthch/ 'December ', X 1 ' January ', 'February ', ' March ', ' April ', X 2 ' May ', ' June ', ' July ', ' August ', X 3 'September', ' October ', 'November ', 'December ', X 4 ' January '/ X X XC ALLOW FOR OVERFLOWS... X IMM=IM+1 Xc *** monthn = monthch(imm) XC String assignment Xc X Do 1 i=1,9 XC INTEGER*1-at-a-time X Monthn(i) = months(i,imm) X 1 Continue X Xc All done. X X return X end Xc -h- ICVT routines X Integer*2 function Icvtbin(ich2) X Character*2 ich2 X Character*2 wrk X integer*2 iwrk,ians X Equivalence(wrk,iwrk) Xc convert 2 digit Integer*4 to number Xc avoid trick version from VAX that depends on byte Xc ordering (which fails on MC68000). X wrk=ich2 X Read(wrk,1,err=2)ians X1 Format(BN,I2) X2 Continue X Icvtbin=ians X Return X End X Function Icvtbn1(nnn) X Integer*1 nnn X Integer*4 kkk X kkk=48 X if(nnn.ge.48.and.nnn.le.57)kkk=nnn X kkk=kkk-48 Xc return 0 or digit value... X Icvtbn1=kkk X Return X End Xd subroutine dely Xd Integer*4 idly,i1 Xd common/xxxyyy/idly Xd idly=0 Xd do 1 i1=1,15000 Xd idly=idly+i1 Xd1 continue Xd idly=idly/100 Xd return Xd end X X END_OF_FILE if test 21276 -ne `wc -c <'Dtc2.For.ac'`; then echo shar: \"'Dtc2.For.ac'\" unpacked with wrong size! fi # end of 'Dtc2.For.ac' fi if test -f 'appdtc.inc' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'appdtc.inc'\" else echo shar: Extracting \"'appdtc.inc'\" $558 characters$ sed "s/^X//" >'appdtc.inc' <<'END_OF_FILE' Xc Begin common APPTDTC.INC X X parameter (iwrkln = 100) XC Can't use it below X character*100 workstr X character*84 apptstr XC icmln X XC Range of hash values (input) X integer*4 irqhash(2), X 1 irchash, ihy, ihm, ihd, iht, iaptln, istart, iwkln XC outputs X X INTEGER*1 appoin(icmln), work(iwrkln) X X common /apptdtc/ irqhash, irchash, ihy, ihm, ihd, iht, X 1 iaptln, istart, iwkln, workstr, apptstr X X equivalence (apptstr, appoin), (workstr, work) X Xc End common APPTDTC.INC XC -h- comdtc.inc Tue Jul 8 16:16:24 1986 END_OF_FILE if test 558 -ne `wc -c <'appdtc.inc'`; then echo shar: \"'appdtc.inc'\" unpacked with wrong size! fi # end of 'appdtc.inc' fi if test -f 'apptdtc.inc' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'apptdtc.inc'\" else echo shar: Extracting \"'apptdtc.inc'\" $558 characters$ sed "s/^X//" >'apptdtc.inc' <<'END_OF_FILE' Xc Begin common APPTDTC.INC X X parameter (iwrkln = 100) XC Can't use it below X character*100 workstr X character*84 apptstr XC icmln X XC Range of hash values (input) X integer*4 irqhash(2), X 1 irchash, ihy, ihm, ihd, iht, iaptln, istart, iwkln XC outputs X X INTEGER*1 appoin(icmln), work(iwrkln) X X common /apptdtc/ irqhash, irchash, ihy, ihm, ihd, iht, X 1 iaptln, istart, iwkln, workstr, apptstr X X equivalence (apptstr, appoin), (workstr, work) X Xc End common APPTDTC.INC XC -h- comdtc.inc Tue Jul 8 16:16:24 1986 END_OF_FILE if test 558 -ne `wc -c <'apptdtc.inc'`; then echo shar: \"'apptdtc.inc'\" unpacked with wrong size! fi # end of 'apptdtc.inc' fi if test -f 'comdtc.inc' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'comdtc.inc'\" else echo shar: Extracting \"'comdtc.inc'\" $1020 characters$ sed "s/^X//" >'comdtc.inc' <<'END_OF_FILE' Xc Common file COMDTC.INC for Desk Top Calendar programs Xc X parameter (iterm = 7) XC Terminal unit number Xc XC Length of character buffers X parameter (icmln = 84) X PARAMETER (iaptlim = 68) XC maximum displayed length Xc X Integer*4 comlen, comidx XC Current info X INTEGER*1 line(icmln) XC command line X common /cmdlin/ comlen, comidx, line Xc X Integer*4 tokstart, toklen, tokfidx XC Command-line scanning info X INTEGER*1 tokfound XC for multi-token scans X common /cmdscan/ tokstart, toklen, tokfidx, tokfound Xc X Integer*4 rdspfg XC flag to reverse sense of display of time X Integer*4 ctlfg XC misc control flags here X common /ctls/ rdspfg, ctlfg Xc X Integer*4 idyr, idmo, iddy, incmod, ibigyr X common /defdat/ idyr, idmo, iddy, incmod, ibigyr Xc X Integer*4 fnsz XC Size of filename X INTEGER*1 fname(60) X Character*60 fnc Xc X common /fn/ fnsz, fname X Equivalence(fnc,fname(1)) Xc X INTEGER*1 ucmask XC Useful constant XC End of COMDTC.INC X END_OF_FILE if test 1020 -ne `wc -c <'comdtc.inc'`; then echo shar: \"'comdtc.inc'\" unpacked with wrong size! fi # end of 'comdtc.inc' fi if test -f 'comdtcd.inc' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'comdtcd.inc'\" else echo shar: Extracting \"'comdtcd.inc'\" $121 characters$ sed "s/^X//" >'comdtcd.inc' <<'END_OF_FILE' Xc Common file COMDTCd.INC for Desk Top Calendar programs Xc X Data ucmask/95/ XC Useful constant XC End of COMDTCD.INC X END_OF_FILE if test 121 -ne `wc -c <'comdtcd.inc'`; then echo shar: \"'comdtcd.inc'\" unpacked with wrong size! fi # end of 'comdtcd.inc' fi if test -f 'dtc.hlp' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'dtc.hlp'\" else echo shar: Extracting \"'dtc.hlp'\" $1781 characters$ sed "s/^X//" >'dtc.hlp' <<'END_OF_FILE' X The DTC program provides an on-line appointment scheduler and calendar Xfacility. The program has three display commands, D/W/M for Day-/Week-/ XMonth-At-A-Glance, plus alternate-display and schedule-file maintenance Xcommands. It is invoked by: X DTC [[command] [date]]. X If no command is given, the DTC command menu is displayed. Commands are Xthen requested and processed until the user types Q (quit), EX (exit), or ^Z. X The date format is mmddyy for Day and Week, and mmyy for the month part. XThe command "D 052785" displays appointments for May 27, 1985. The command: X"9:00 <appointment string>" would insert the appointment specified by X"appointment string" at 9 AM on the default date. The default date is the last Xdate given unless the I command is used to reset to today's date. Dates may be Xgiven as mmddyy, mm/dd/yy, or dd-mmm-yy, or reasonable subsets (i.e, "D 5" Xshows appointments for the fifth of the current month, "M 7/86" is July 1986). XTime entries of the form hh:mm>hh:mm specify ranges. A CLI command to enter an Xappointment might be (quote is used to preserve lower-case, no final quote): X 1>DTC "D 041585 9:00 Income Tax due tonight XIndirection: X Entries in the DTC file of form "999999080 dir/filename.typ=" point at the Xfilename and the S or G cmds enter appts. in them, other cmds read them. Use Xthe F cmd to change files. DTC commands T, C, and R correspond to D, M, and W Xbut exit after one display. More info in DTC.MEM. END_OF_FILE if test 1781 -ne `wc -c <'dtc.hlp'`; then echo shar: \"'dtc.hlp'\" unpacked with wrong size! fi # end of 'dtc.hlp' fi if test -f 'dtcmak.cmd' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'dtcmak.cmd'\" else echo shar: Extracting \"'dtcmak.cmd'\" $88 characters$ sed "s/^X//" >'dtcmak.cmd' <<'END_OF_FILE' Xecho build for DTC XF77 -K DTC.For XF77L -o Dtc.Exe -l l:f77.rl dtc l:date.sub l:time.sub END_OF_FILE if test 88 -ne `wc -c <'dtcmak.cmd'`; then echo shar: \"'dtcmak.cmd'\" unpacked with wrong size! fi # end of 'dtcmak.cmd' fi if test -f 'dtcrelnt.txt' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'dtcrelnt.txt'\" else echo shar: Extracting \"'dtcrelnt.txt'\" $678 characters$ sed "s/^X//" >'dtcrelnt.txt' <<'END_OF_FILE' XDeskTop Calendar - release notes X XThis version of DTC runs correctly under AmigaDos 1.2 with interlace Xon. Some extra stack may be required but in general will not be as the Xnumber of COMMONs is small. X It is believed to run OK in non-interlace systems also. In this Xversion the year display CAN be used, but only if you reset the default Xfont to a 5 by 7 font (e.g. the "smallfont" font I have distributed in Xthe public domain). This permits 128-wide screens, which the year Xdisplay needs. Everything else only needs at most 80 chars. X Most glitches in display are fixed and all source code is here Xfor your use, so the program is a useful calendar system now. X Glenn Everhart END_OF_FILE if test 678 -ne `wc -c <'dtcrelnt.txt'`; then echo shar: \"'dtcrelnt.txt'\" unpacked with wrong size! fi # end of 'dtcrelnt.txt' fi if test -f 'dtcxidate.inc' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'dtcxidate.inc'\" else echo shar: Extracting \"'dtcxidate.inc'\" $216 characters$ sed "s/^X//" >'dtcxidate.inc' <<'END_OF_FILE' Xc *** Common file DTCXIDTATE for dummy IDATE subroutine of DTC program X X integer*4 xim, xid, xiy, xibgyr XC Month, day, year (yy), year (yyyy) X common /xidate/ xim, xid, xiy, xibgyr X Xc *** End DTCXIDATE.INC END_OF_FILE if test 216 -ne `wc -c <'dtcxidate.inc'`; then echo shar: \"'dtcxidate.inc'\" unpacked with wrong size! fi # end of 'dtcxidate.inc' fi if test -f 'escdtc.inc' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'escdtc.inc'\" else echo shar: Extracting \"'escdtc.inc'\" $535 characters$ sed "s/^X//" >'escdtc.inc' <<'END_OF_FILE' Xc Common file ESCDTC.INC for Desk Top Calendar programs Xc XC Special sequences X character*2 homescrn, clrscrn, X 1 dhdw1, dhdw2, dwide, resetvattr X character*3 revattr XC Greasy? X common /vidstuff/ homescrn, clrscrn, X 1 dhdw1, dhdw2, dwide, resetvattr, revattr XC Compiler will usually treat these as constants, so don't really need them Xc to be in common Xc XC ASCII escape XC ^N, Shift-Out (enter graphics mode w/ ')0') X Integer*1 esc,so,si XC ^O, Shift-In (exit graphics mode w/ '(B') XC End of ESCDTC.INC X END_OF_FILE if test 535 -ne `wc -c <'escdtc.inc'`; then echo shar: \"'escdtc.inc'\" unpacked with wrong size! fi # end of 'escdtc.inc' fi if test -f 'escdtcd.inc' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'escdtcd.inc'\" else echo shar: Extracting \"'escdtcd.inc'\" $178 characters$ sed "s/^X//" >'escdtcd.inc' <<'END_OF_FILE' Xc Common file ESCDTCD.INC for Desk Top Calendar programs Xc XC Special sequences X Data esc/27/,so/14/,si/15/ XC ^O, Shift-In (exit graphics mode w/ '(B') XC End of ESCDTC.INC X END_OF_FILE if test 178 -ne `wc -c <'escdtcd.inc'`; then echo shar: \"'escdtcd.inc'\" unpacked with wrong size! fi # end of 'escdtcd.inc' fi if test -f 'stmtfunc.for' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'stmtfunc.for'\" else echo shar: Extracting \"'stmtfunc.for'\" $1129 characters$ sed "s/^X//" >'stmtfunc.for' <<'END_OF_FILE' Xc Useful statement functions: Xc 1) type checking of single character Xc 2) quick binary to 2-digit bcd conversion, and vice versa Xc 3) Check for leap-year (Gregorian) Xc 4) Hashdate for DTC appointment matching Xc Xc ! Character type checking X numeric(ch) = (ch .GE. 48) .AND. (ch .LE.57) X chnumeric(chch) = (chch .GE. '0') .AND. (chch .LE. '9') X lcalpha(ch) = (ch .GE.97) .AND. (ch .LE.122) X alpha(ch)=((ch.ge.65.and.ch.le.90).or.(ch.ge.97.and.ch.le.122)) Xc alpha(ch) = ((ch .AND. Z'5f5f5f5f') .GE.65) Xc 1 .AND. ((ch .AND. Z'5f5f5f5f') .LE. 90) Xc Xc Icvtbcd now unused Xc Icvtbin replaced by real function in dtc.for Xc Xc icvtbcd(inum) = ((MOD(inum, 10) * 256) .OR. inum/10) .OR. '00' Xc icvtbin(ich2) = ((ich2 .AND. Z'000F') * 10) Xc 1 + ((ich2 .AND. Z'0F00')/256) Xc ! Works w/space as first char Xc icvtbn1(ch) = ch .AND. Z'0F' Xc ! Convert single character Xc X islpyr(izyr) = (mod(izyr, 400) .EQ. 0) .OR. X 1 ((izyr .AND. 3) .EQ. 0) .AND. (mod(izyr, 100) .NE. 0) Xc X ihymd(izyr, izmo, izdy) = (((izyr * 16) + izmo) * 32) + izdy Xc Xc End statement functions X END_OF_FILE if test 1129 -ne `wc -c <'stmtfunc.for'`; then echo shar: \"'stmtfunc.for'\" unpacked with wrong size! fi # end of 'stmtfunc.for' fi if test -f 'stmtfuncsp.for' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'stmtfuncsp.for'\" else echo shar: Extracting \"'stmtfuncsp.for'\" $682 characters$ sed "s/^X//" >'stmtfuncsp.for' <<'END_OF_FILE' Xc Useful statement functions: Xc 1) type checking of single character Xc 2) quick binary to 2-digit bcd conversion, and vice versa Xc 3) Check for leap-year (Gregorian) Xc 4) Hashdate for DTC appointment matching Xc Xc specification stmts Xc ! Character type checking X logical numeric, chnumeric, X 1 lcalpha, alpha, X 2 islpyr Xc ! value check X integer*1 ch Xc ! Single argument X character*1 chch Xc integer*2 ich2 Xc ! Conversion routines Xc ! Compilation default Xc integer*2 icvtbn1, inum, ihymd, X integer*4 inum, ihymd, X 1 izyr, izmo, izdy Xc ! .. Xc Xc End statement functions specifications X END_OF_FILE if test 682 -ne `wc -c <'stmtfuncsp.for'`; then echo shar: \"'stmtfuncsp.for'\" unpacked with wrong size! fi # end of 'stmtfuncsp.for' fi echo shar: End of archive 1 $of 6$. cp /dev/null ark1isdone MISSING="" for I in 1 2 3 4 5 6 ; do if test ! -f ark${I}isdone ; then MISSING="${MISSING} ${I}" fi done if test "${MISSING}" = "" ; then echo You have unpacked all 6 archives. rm -f ark[1-9]isdone else echo You still need to unpack the following archives: echo " " ${MISSING} fi ## End of shell archive. exit 0 -- Mail submissions (sources or binaries) to <amiga@cs.odu.edu>. Mail comments to the moderator at <amiga-request@cs.odu.edu>. Post requests for sources, and general discussion to comp.sys.amiga.